Download data

First we download data from THL open data repository.

# https://thl.fi/fi/tilastot-ja-data/aineistot-ja-palvelut/avoin-data/varmistetut-koronatapaukset-suomessa-covid-19-

dat <- read.csv("data/covid_statistics_history.csv") # Historical, mostly weekly data until 2021-02-15
dat$period <- ifelse(grepl("Vuosi",dat$date), "weekly","daily")
dat <- dat[!is.na(dat$value),]

dat2 <- read.csv("http://77.86.191.32/rtools_server/runs/covid_statistics_daily_fi.csv") #daily updates
dat2$period <- "cumulative"

dat <- rbind(dat, dat2)
colnames(dat)[1:3] <- c("place","age","date")
for(i in c("place","age","date","sex","measure")) {
  dat[[i]] <- as.factor(dat[[i]])
}

start <- as.POSIXct("2019-12-29 12:00 EET")
shp <- as.character(unique(dat$place[grep("(SHP|Ahvenanmaa)",dat$place)]))

dat$time <- (start + (as.numeric(substr(dat$date,10,10)) * 53 + as.numeric(substr(dat$date,19,20))) * 7*24*3600)
dat$time[dat$period!="weekly"] <- as.POSIXct(paste0(dat$date[dat$period!="weekly"], " 12:00 EET"))

dat$value[dat$value==".."] <- "-1"
dat$value <- as.integer(dat$value)

# Find the highest weekly case value for each place. Note: for only ca. 10 places the peak occurs before August 2020.

tmp <- dat[dat$period=="weekly" & dat$measure=="cases",] %>%
  mutate(value=as.integer(value)) %>%
  group_by(place) %>%
  filter(value == max(value,na.rm=TRUE))
tmp <- tmp[!duplicated(tmp$place),c("place","time")]
colnames(tmp)[2] <- "peak"  
dat <- merge(dat, tmp, all.x=TRUE)
dat$peak <- dat$time - dat$peak

#####################

# This code should be updated. It contains the location hierarchy.
if(FALSE) {
rl <- readLines("https://sampo.thl.fi/pivot/prod/fi/epirapo/covid19case/fact_epirapo_covid19case.dimensions.json")
rl[1] <- "{"
rl[2] <- '"test":['
rl[length(rl)] <- "}"
rl <- jsonlite::fromJSON(rl)

tst <- unlist(rl, recursive=FALSE)
} # ENDIF

############################3

Data analysis and plots

What is the timeline of cases? What is the timeline relative to the peak value in each place?

tmp <- dat[dat$measure == "cases" & grepl("SHP",dat$place) & dat$period=="weekly" , ]
tmp <- tmp[order(tmp$peak),]

# Plot health care district cases along the timeline
plot_ly(data = tmp, x=~time,  y=~value, type="scatter", mode="lines", fillcolor=~place) %>%
  layout(title="Weekly cases by health care district")
## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
# Plot health care district cases relative to the peak event
plot_ly(data = tmp, x=~peak, y=~as.numeric(value), type="scatter", mode="lines", fillcolor=~place) %>%
  layout(title="Weekly cases by health care district relative to the peak")
tmp <- dat[dat$measure=="cases" & !grepl("SHP",dat$place) & dat$period=="weekly",]
tmp <- tmp[order(tmp$peak),]

# Plot municipality cases relative to the peak event
plot_ly(data = tmp, x=~peak, y=~value, type="scatter", mode="lines", fillcolor=~place) %>%
  layout(title="Weekly cases by municipality relative to the peak")
# See how many-fold the decrease is 2 weeks after the peak
tmp <- tmp[!is.na(tmp$peak) & (tmp$peak == 0 | tmp$peak == 14*24*3600) , ]
tmp$value[tmp$peak!=0] <- 1 / tmp$value[tmp$peak!=0]
tmp <- aggregate(tmp["value"], by = tmp[c("place","measure","period")], FUN = prod)
cat("See how many-fold the decrease is 2 weeks after the largest peak in each place\n
    If a place is not in the list, both values are below the detection limit.\n
    Negative values mean that the peak had that number of cases and then decreased to below the detection limit.\n
    Vantaa is an artifact because the peak is 2021-02-14 and therefore the second value is missing.\n")
## See how many-fold the decrease is 2 weeks after the largest peak in each place
## 
##     If a place is not in the list, both values are below the detection limit.
## 
##     Negative values mean that the peak had that number of cases and then decreased to below the detection limit.
## 
##     Vantaa is an artifact because the peak is 2021-02-14 and therefore the second value is missing.
tmp[tmp$value!=1,]
##                  place measure period      value
## 1           Ahvenanmaa   cases weekly   3.375000
## 3             Alajärvi   cases weekly   6.857143
## 7               Askola   cases weekly  -8.000000
## 8                 Aura   cases weekly  -6.000000
## 9               Brändö   cases weekly -12.000000
## 13               Espoo   cases weekly   1.211321
## 22           Haapavesi   cases weekly  -6.000000
## 25              Hamina   cases weekly -11.000000
## 27          Hankasalmi   cases weekly  -8.000000
## 31             Hattula   cases weekly   1.666667
## 32           Hausjärvi   cases weekly  -5.000000
## 33             Heinola   cases weekly  -9.000000
## 35            Helsinki   cases weekly   1.040142
## 37             Hollola   cases weekly   1.181818
## 38           Honkajoki   cases weekly -18.000000
## 42            Hyvinkää   cases weekly   1.437500
## 43          Hämeenkyrö   cases weekly  -8.000000
## 44         Hämeenlinna   cases weekly   3.750000
## 45                  Ii   cases weekly  -5.000000
## 46             Iisalmi   cases weekly  -7.000000
## 48           Ikaalinen   cases weekly  -6.000000
## 50           Ilomantsi   cases weekly -12.000000
## 51              Imatra   cases weekly   2.875000
## 57             Joensuu   cases weekly   4.230769
## 64                Juva   cases weekly  -5.000000
## 65           Jyväskylä   cases weekly   4.363636
## 67               Jämsä   cases weekly  -9.000000
## 68           Järvenpää   cases weekly  73.000000
## 69             Kaarina   cases weekly   3.090909
## 71       Kaikki Alueet   cases weekly   1.079174
## 72             Kajaani   cases weekly -15.000000
## 73            Kalajoki   cases weekly  -9.000000
## 74           Kangasala   cases weekly   2.200000
## 75         Kangasniemi   cases weekly -15.000000
## 76          Kankaanpää   cases weekly  -5.000000
## 78              Kannus   cases weekly  -5.000000
## 80            Karkkila   cases weekly   2.500000
## 82              Karvia   cases weekly -27.000000
## 84           Kauhajoki   cases weekly  -9.000000
## 85             Kauhava   cases weekly  -5.000000
## 86          Kauniainen   cases weekly  -9.000000
## 87           Kaustinen   cases weekly  -6.000000
## 89                Kemi   cases weekly   2.600000
## 92         Kemiönsaari   cases weekly  -7.000000
## 93             Kempele   cases weekly -14.000000
## 94              Kerava   cases weekly -36.000000
## 98         Kirkkonummi   cases weekly   1.111111
## 99               Kitee   cases weekly -22.000000
## 100            Kittilä   cases weekly -16.000000
## 101          Kiuruvesi   cases weekly -14.000000
## 104            Kokkola   cases weekly  -5.000000
## 105             Kolari   cases weekly -10.000000
## 108            Korsnäs   cases weekly  -9.000000
## 110              Kotka   cases weekly   5.166667
## 111            Kouvola   cases weekly   2.933333
## 112 Kristiinankaupunki   cases weekly  -8.000000
## 113          Kruunupyy   cases weekly -10.000000
## 114              Kuhmo   cases weekly -13.000000
## 117             Kuopio   cases weekly   5.000000
## 119            Kurikka   cases weekly  -7.000000
## 122           Kyyjärvi   cases weekly  -6.000000
## 126              Lahti   cases weekly   4.794872
## 128            Laitila   cases weekly -19.000000
## 129         Lapinjärvi   cases weekly  -7.000000
## 132       Lappeenranta   cases weekly   2.125000
## 133              Lapua   cases weekly  -5.000000
## 134             Laukaa   cases weekly  -9.000000
## 137           Lempäälä   cases weekly   3.083333
## 139         Lestijärvi   cases weekly  -6.000000
## 140             Lieksa   cases weekly -23.000000
## 141              Lieto   cases weekly   2.333333
## 142            Liminka   cases weekly  -5.000000
## 144              Lohja   cases weekly -19.000000
## 145             Loimaa   cases weekly -14.000000
## 146              Loppi   cases weekly -11.000000
## 147            Loviisa   cases weekly   2.428571
## 151              Luoto   cases weekly -22.000000
## 153           Maalahti   cases weekly  -8.000000
## 154      Maarianhamina   cases weekly   2.600000
## 156              Masku   cases weekly -15.000000
## 160            Mikkeli   cases weekly -69.000000
## 161              Muhos   cases weekly  -5.000000
## 164         Mustasaari   cases weekly   3.538462
## 165            Muurame   cases weekly  -7.000000
## 166           Mynämäki   cases weekly  -5.000000
## 168           Mäntsälä   cases weekly   1.666667
## 169    Mänttä-Vilppula   cases weekly -10.000000
## 171           Naantali   cases weekly   2.250000
## 173             Nivala   cases weekly  -7.000000
## 174              Nokia   cases weekly -14.000000
## 177         Nurmijärvi   cases weekly   1.190476
## 178             Närpiö   cases weekly   3.166667
## 179         Orimattila   cases weekly  -9.000000
## 183               Oulu   cases weekly   2.764045
## 186             Paimio   cases weekly  29.000000
## 188           Parainen   cases weekly -13.000000
## 190            Parkano   cases weekly -21.000000
## 191   Pedersören kunta   cases weekly   2.166667
## 196         Petäjävesi   cases weekly  -6.000000
## 197         Pieksämäki   cases weekly   1.439024
## 199        Pietarsaari   cases weekly -14.000000
## 201           Pirkkala   cases weekly -25.000000
## 204               Pori   cases weekly  50.000000
## 205          Pornainen   cases weekly  -5.000000
## 206             Porvoo   cases weekly   3.000000
## 210        Punkalaidun   cases weekly  -6.000000
## 212            Puumala   cases weekly  -5.000000
## 213             Pyhtää   cases weekly  -9.000000
## 216            Pyhäntä   cases weekly  -7.000000
## 217          Pyhäranta   cases weekly  -5.000000
## 219             Pöytyä   cases weekly  -6.000000
## 220              Raahe   cases weekly   1.200000
## 221          Raasepori   cases weekly  -9.000000
## 222             Raisio   cases weekly   3.125000
## 225              Rauma   cases weekly   1.057143
## 226         Rautalampi   cases weekly   2.333333
## 229          Reisjärvi   cases weekly  -5.000000
## 230          Riihimäki   cases weekly -16.000000
## 232          Rovaniemi   cases weekly -25.000000
## 235              Rusko   cases weekly  -6.000000
## 239               Salo   cases weekly   2.625000
## 241          Sastamala   cases weekly  -7.000000
## 244         Savonlinna   cases weekly   1.687500
## 246          Seinäjoki   cases weekly   4.600000
## 247              Sievi   cases weekly  -7.000000
## 251        Siilinjärvi   cases weekly -17.000000
## 253              Sipoo   cases weekly   3.000000
## 254            Siuntio   cases weekly  -6.000000
## 255          Sodankylä   cases weekly -31.000000
## 256              Soini   cases weekly  -6.000000
## 257             Somero   cases weekly  -8.000000
## 259            Sotkamo   cases weekly  -9.000000
## 264         Suonenjoki   cases weekly  -6.000000
## 271            Tampere   cases weekly   7.764706
## 278             Tornio   cases weekly   3.300000
## 279              Turku   cases weekly   2.006452
## 281            Tuusula   cases weekly  39.000000
## 282            Tyrnävä   cases weekly  -8.000000
## 287           Uurainen   cases weekly  -7.000000
## 288      Uusikaarlepyy   cases weekly -12.000000
## 289       Uusikaupunki   cases weekly   1.875000
## 291              Vaasa   cases weekly  27.230769
## 292        Valkeakoski   cases weekly -22.000000
## 293             Vantaa   cases weekly 373.000000
## 294            Varkaus   cases weekly -10.000000
## 299            Vieremä   cases weekly  -6.000000
## 300              Vihti   cases weekly   1.571429
## 302            Vimpeli   cases weekly  -9.000000
## 304             Virrat   cases weekly -11.000000
## 306              Vöyri   cases weekly -14.000000
## 307          Ylitornio   cases weekly -12.000000
## 308          Ylivieska   cases weekly -17.000000
## 309           Ylöjärvi   cases weekly -11.000000
## 312          Äänekoski   cases weekly   4.200000
muni <- dat[dat$measure=="cases" & dat$period!="daily" & dat$age=="Kaikki ikäryhmät" & dat$sex=="Kaikki sukupuolet",
            !colnames(dat) %in% c("age","sex","measure")]
muni$daily <- muni$value / 7

tmp2 <- muni[muni$period=="cumulative",] # tmp[tmp$date=="2021-02-15",] # Start time of daily follow-up
tmp2$old <- tmp2$value
tmp2$time <- tmp2$time + 24*3600
tmp2 <- tmp2[colnames(tmp2) %in% c("place","time","old")]
muni <- merge(muni, tmp2, all.x=TRUE)
muni$daily <- ifelse(muni$period=="cumulative", muni$value - muni$old, muni$daily)
muni <- muni[!is.na(muni$daily) & muni$time < Sys.time() , ]
muni <- muni[order(muni$time),]
week <- numeric()
for(i in 1:nrow(muni)) {
  ts <- muni[muni$place==muni$place[i] , c("time","daily")]
  week <- c(week, mean(ts$daily[ts$time <= muni$time[i] & ts$time > muni$time[i]- 7*24*3600],na.rm = TRUE))
}
muni$week <- week

plot_ly(data = muni, x = ~time, y=~daily, fillcolor=~place, type="scatter", mode="lines") %>%
  layout(title="Daily cases of covid-19 by place")
tmp <- c("Helsinki","Espoo","Vantaa","Turku","Kuopio","Vaasa")
plot_ly(data = muni[muni$place %in% tmp,], x = ~time, y=~daily, fillcolor=~place, type="scatter", mode="lines") %>%
  layout(title="Daily cases of covid-19 by place")
plot_ly(data = muni[muni$place %in% shp , ], x = ~time, y=~daily, fillcolor=~place, type="scatter", mode="lines") %>%
  layout(title="Daily cases of covid-19 by place")
plot_ly(data = muni[muni$place %in% tmp , ], x = ~time, y=~week, fillcolor=~place, type="scatter", mode="lines") %>%
  layout(title="Weekly average cases of covid-19 by place")
#################### VACCINATION

vac <- read.csv("http://77.86.191.32/rtools_server/runs/covid_vaccination_daily_fi.csv") #daily updates
for(i in c(1,2,5)) {
  vac[[i]] <- as.factor(vac[[i]])
}
vac$time <- as.POSIXct(vac$time)
vac$SHP <- grepl("(SHP|Ahvenanmaa)",vac$place)

days <- length(unique(vac$time))
vac <- vac[vac$SHP & vac$age!="Kaikki iät",]
vac <- vac[!(vac$time=="2021-03-01" & vac$measure=="second shot"),] # There seems to be double counting in data


tmp <- aggregate(vac$value, by = vac[c("place","time","measure")], FUN=function(x) sum(x, na.rm=TRUE))
plot_ly(tmp, x = ~time, y = ~x, color = ~place, linetype = ~measure, type="scatter", mode="lines") %>%
  layout(title="Rokotuskattavuus")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
tmp <- aggregate(vac$value, by = vac[c("age","time","measure")], FUN=function(x) sum(x, na.rm=TRUE))
plot_ly(tmp, x = ~time, y = ~x, color = ~age, linetype = ~measure, type="scatter", mode="lines") %>%
  layout(title="Rokotuskattavuus")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors

## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
tmp <- aggregate(vac$value, by = vac[c("time","measure")], FUN=function(x) sum(x, na.rm=TRUE))
plot_ly(tmp, x = ~time, y = ~x, color = ~measure, type="scatter", mode="lines") %>%
  layout(title="Rokotuskattavuus")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
tmp <- aggregate(vac$value, by = vac[c("age","measure")], FUN=function(x) sum(x, na.rm=TRUE))
tmp$x <- tmp$x / days
plot_ly(tmp, x = ~age, y = ~x, color = ~measure, type="scatter", mode="lines") %>%
  layout(title="Rokotuskattavuus")
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels

Conclusions